home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 21 / Cream of the Crop 21 (Terry Blount) (October 1996).iso / database / tickle15.zip / TKLPACK.PPE (.txt) < prev    next >
PCBoard Programming Language Executable  |  1996-08-02  |  5KB  |  301 lines
  1. ;------------------------------------------------------------------------------
  2. ;                                                   .ss.
  3. ;                                                   `²²'
  4. ;             .,sS$Ss,,s$  .,sS$$$Ss.  .,sS$Ss,,s$ .ss.  .sSs.
  5. ;           .d$$²^°²$$$$'.d$P²°^^²$P'.d$$²^°²$$$$'.$$$' .$$$²Sb,.
  6. ;           $$$'   .$$$' $$$²Sçsµ²' .$$$'   .$$$'.$$$' .$$$'  `$$b.
  7. ;           $$$b,,d$$$' ,$$$b,....,s$$$$b,,d$$$'.$$$;.,$$$'    ;$$$
  8. ;           `²S$$S²²S$$S²°²S$$$$S²°°²S$$$$$$',$$S²°²S$S'.sS$$$P²'
  9. ;                                    .sS²°$$$²²°"'       d²°'
  10. ;                                  .$$²  .$$'
  11. ;                                  $$$.,d$$'
  12. ;                                  `²S$$S²'
  13. ;------------------------------------------------------------------------------
  14. ; P.P.L.X. 2.OO                          (C)1996 - Lone Runner / AEGiS CoRP'96 
  15. ;------------------------------------------------------------------------------
  16. ; PPE 3.1O (Encryption type I) - Analysis ON - Postprocessing ON
  17. ;------------------------------------------------------------------------------
  18.  
  19.     Boolean  BOOLEAN001
  20.     Boolean  BOOLEAN002
  21.     Boolean  BOOLEAN003
  22.     Integer  INTEGER001
  23.     Integer  INTEGER002
  24.     Real     REAL001
  25.     Real     REAL002
  26.     Real     REAL003
  27.     String   STRING001
  28.     String   STRING002
  29.     String   STRING003
  30.     String   STRING004
  31.     String   STRING005
  32.     String   STRING006
  33.     String   STRING007
  34.     Int      INT001
  35.     Int      INT002
  36.     Int      INT003
  37.     Int      INT004
  38.     Int      INT005
  39.     Int      INT006
  40.     Int      INT007
  41.     Int      INT008
  42.  
  43. ;------------------------------------------------------------------------------
  44.  
  45.     STRING006 = PPEPath() + "TKLTEXT" + LangExt()
  46.     Cls
  47.     Newlines 3
  48.     PrintLn ReadLine(STRING006, 59)
  49.     Newlines 2
  50.     Delay 18
  51.     Print ReadLine(STRING006, 60)
  52.     Gosub LABEL007
  53.     PrintLn ReadLine(STRING006, 61)
  54.     Newline
  55.     Print ReadLine(STRING006, 62)
  56.     Gosub LABEL006
  57.     PrintLn ReadLine(STRING006, 61)
  58.     Newline
  59.     Print ReadLine(STRING006, 63)
  60.     Gosub LABEL009
  61.     If (DErr(0)) Then
  62.         SPrintLn ReadLine(STRING006, 64)
  63.         Log "Cannot open TICKLE.DBF (DataBase) in EXCLUSIVE mode - Aborting", 0
  64.     Else
  65.         Gosub LABEL010
  66.         If (DErr(0)) Then
  67.             SPrintLn ReadLine(STRING006, 4)
  68.             Log "Cannot open TICKLE.NDX (Index) - Aborting", 0
  69.         Else
  70.             PrintLn ReadLine(STRING006, 61)
  71.             Newline
  72.             PrintLn ReadLine(STRING006, 65)
  73.             Newline
  74.             Delay 36
  75.             Gosub LABEL001
  76.             If (INT006 > 0) Then
  77.                 Newlines 2
  78.                 PrintLn ReadLine(STRING006, 66)
  79.                 Newlines 2
  80.                 DTop 0
  81.                 DPack 0
  82.             Endif
  83.             FPutLn 2, "Total Number of Records in Database After Pack  : ", DRecCount(0)
  84.             FPutLn 2
  85.             FPutLn 2, "Total Users Deleted : ", INT006
  86.             FPutLn 2, "     Time Completed : ", Time()
  87.             FClose 2
  88.             Newline
  89.             PrintLn ReadLine(STRING006, 67)
  90.             Newline
  91.             Goto LABEL008
  92.             End
  93.             :LABEL001
  94.             DTop 0
  95.             PrintLn ReadLine(STRING006, 68)
  96.             Newline
  97.             FAppend 2, PPEPath() + PPEName() + ".log", 1, 0
  98.             FPutLn 2
  99.             FPutLn 2
  100.             FPutLn 2, "========================================================================"
  101.             FPutLn 2
  102.             FPutLn 2, "Tickle File Packing Program - Version 1.10"
  103.             FPutLn 2, "Written by Dan Shore - SysOp - The Shoreline BBS"
  104.             FPutLn 2
  105.             FPutLn 2, "      Date of Pack : ", Date()
  106.             FPutLn 2, "Start Time of Pack : ", Time()
  107.             FPutLn 2
  108.             For INT001 = 1 To DRecCount(0)
  109.                 StartDisp 1
  110.                 DGo 0, INT001
  111.                 STRING001 = DGet(0, DName(0, 1))
  112.                 STRING003 = Left(STRING001, 1)
  113.                 If (STRING003 < "A") STRING003 = "A"
  114.                 If (STRING003 > "Z") STRING003 = "Z"
  115.                 FPut 2, "Processing Username: ", STRING001
  116.                 If (INT007) Goto LABEL002
  117.                 Print ReadLine(STRING006, 69)
  118.                 INT007 = GetX()
  119.                 INT008 = GetY()
  120.                 :LABEL002
  121.                 AnsiPos INT007, INT008
  122.                 Print INT001
  123.                 Gosub LABEL003
  124.                 BOOLEAN003 = 0
  125.                 If ((STRING007 == "TRUE") && BOOLEAN002) Gosub LABEL011
  126.                 If (!BOOLEAN002 || ((STRING007 == "TRUE") && (BOOLEAN003 == "FALSE"))) Then
  127.                     If (!BOOLEAN002) FPutLn 2, "Not Current User - Deleted"
  128.                     If ((BOOLEAN002 && (STRING007 == "TRUE")) && (BOOLEAN003 == 0)) FPutLn 2, "No Files - Deleted"
  129.                     DDelete 0
  130.                     Inc INT006
  131.                     Continue
  132.                 Endif
  133.                 FPutLn 2, "Current User"
  134.             Next
  135.             PrintLn "@X07"
  136.             FPutLn 2
  137.             FPutLn 2, "Total Number of Records in Database Before Pack : ", DRecCount(0)
  138.             StartDisp 2
  139.             Return
  140.             :LABEL003
  141.             STRING004 = STRING002 + "PCBNDX." + STRING003
  142.             INTEGER001 = FileInf(STRING004, 4)
  143.             If (INTEGER001 < 27) Then
  144.                 PrintLn ReadLine(STRING006, 70), STRING004, ReadLine(STRING006, 71)
  145.             Endif
  146.             INT004 = INTEGER001 / 27
  147.             INT005 = 0
  148.             FOpen 1, STRING004, 0, 0
  149.             BOOLEAN001 = 0
  150.             BOOLEAN002 = 0
  151.             :LABEL004
  152.             If (BOOLEAN001) Goto LABEL005
  153.             REAL001 = INT004
  154.             REAL002 = INT005
  155.             REAL001 = REAL001 / 2
  156.             REAL002 = REAL002 / 2
  157.             REAL003 = REAL001 + REAL002 + 0.5
  158.             INT003 = REAL003
  159.             INTEGER002 = (INT003 - 1) * 27
  160.             FSeek 1, INTEGER002, 0
  161.             FRead 1, INT002, 2
  162.             FRead 1, STRING005, 25
  163.             If (STRING005 == STRING001) Then
  164.                 BOOLEAN002 = 1
  165.                 BOOLEAN001 = 1
  166.             ElseIf (INT004 - INT005 < 2) Then
  167.                 BOOLEAN001 = 1
  168.             ElseIf (STRING005 < STRING001) Then
  169.                 INT005 = INT003
  170.             ElseIf (STRING005 > STRING001) Then
  171.                 INT004 = INT003
  172.             Endif
  173.             Goto LABEL004
  174.             :LABEL005
  175.             FClose 1
  176.             Return
  177.             :LABEL006
  178.             Copy PPEPath() + "TICKLE.DBF", PPEPath() + "TICKLE.DBK"
  179.             Copy PPEPath() + "TICKLE.NDX", PPEPath() + "TICKLE.NBK"
  180.             Return
  181.             :LABEL007
  182.             FOpen 1, PPEPath() + PPEName() + ".cfg", 0, 0
  183.             FGet 1, STRING002
  184.             FGet 1, STRING007
  185.             If (Ferr(1)) STRING007 = "FALSE"
  186.             FClose 1
  187.             If (STRING007 <> "TRUE") STRING007 = "FALSE"
  188.             STRING002 = Trim(STRING002, " ")
  189.             If (Right(STRING002, 1) <> "\") STRING002 = STRING002 + "\"
  190.             Return
  191.         Endif
  192.     Endif
  193.     :LABEL008
  194.     DnCloseAll 0
  195.     DClose 0
  196.     PrintLn ReadLine(STRING006, 72)
  197.     Newline
  198.     End
  199.     :LABEL009
  200.     DOpen 0, PPEPath() + "tickle", 1
  201.     Return
  202.     :LABEL010
  203.     If (Exist(PPEPath() + "tickle.ndx")) DnOpen 0, PPEPath() + "tickle"
  204.     Return
  205.     :LABEL011
  206.     If (DGet(0, DName(0, 2)) <> "            ") BOOLEAN003 = 1
  207.     Return
  208.  
  209. ;------------------------------------------------------------------------------
  210. ;
  211. ; Usage report (before postprocessing)
  212. ;
  213. ; ■ Statements used :
  214. ;
  215. ;    2       End
  216. ;    1       Cls
  217. ;    21      Goto 
  218. ;    33      Let 
  219. ;    5       Print 
  220. ;    11      PrintLn 
  221. ;    22      If 
  222. ;    2       FOpen 
  223. ;    1       FAppend 
  224. ;    3       FClose 
  225. ;    2       FGet 
  226. ;    1       FPut 
  227. ;    19      FPutLn 
  228. ;    2       StartDisp 
  229. ;    2       Log 
  230. ;    7       Gosub 
  231. ;    7       Return
  232. ;    2       Delay 
  233. ;    1       Inc 
  234. ;    8       Newline
  235. ;    4       Newlines 
  236. ;    1       AnsiPos 
  237. ;    2